perm filename COMMD.SAI[PUB,TES]1 blob sn#129297 filedate 1974-11-05 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00008 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGOF("COMMD")
C00005 00003	PUBLIC SIMPLE PROCEDURE COMMD! $"#
C00006 00004	PUBLIC RECURSIVE BOOLEAN PROCEDURE COMMAND $"#
C00012 00005	PRIVATE SIMPLE PROCEDURE DCOMMANDCHARACTER $"#
C00013 00006	PUBLIC RECURSIVE PROCEDURE PARAMS(INTEGER MOST STRING ARRAY PRE,PAR,POST) $"#
C00016 00007	PUBLIC RECURSIVE STRING PROCEDURE SIMPAR $"#
C00017 00008	FINISHED
C00018 ENDMK
C⊗;
BEGOF("COMMD")
COMMENT

A command name may be one or two words., if two words, they are
concatenated together to form the full name.  Thus, NO FILL = NOFILL
and TURN ON = TURNON.  The COMMAND processor simply dispatches on the
command number associated with each name to a procedure to execute
the command.  Note that COMMAND does not PASS over the command name,
so the called routine must do that (once, even for a two-word name).

The PARAMS routine is a general parser for command parameters like
LINES 4 TO 52 and PRINTING "!-1".  The parameters may appear in any
order, and the cue words may even be omitted if the standard order is
used (this is not mentioned in the manual, but users have been
observed to permute the parameters and to spell two word command
names as one word., in these things at least, PUB is forgiving).

;

PRELOAD!WITH
	"ADJUST",
	"AFTER",
	"APART",
	"AREA",
	"AT",
	"BEFORE",
	"BEGIN",
	"BLANKPAGE",
	"BREAK",
	"BURP",
	"CENTER",
	"CLOSE",
	"COMMANDCHARACTER",
	"COMMENT",
	"COMPACT",
	"CONTINUE",
	"COUNT",
	"CRBREAK",
	"CRSPACE",
	"DDT",
	"DEVICE",
	"DONE",
	"END",
	"FILL",
	"FLUSHLEFT",
	"FLUSHRIGHT",
	"FONT",
	"GROUP",
	"GROUPSKIP",
	"IF",
	"INDENT",
	"INSERT",
	"JUSTJUST",
	"MACRO",
	"NARROW",
	"NEXT",
	"NOFILL",
	"NOJUST",
	"ONCE",
	"PAGEFRAME",
	"PICHAR",
	"PLACE",
	"PORTION",
	"PREFACE",
	"PROCEDURE",
	"PUB!DEBUG",
	"RECEIVE",
	"RECURSIVEMACRO",
	"REPEAT",
	"REQUIRE",
	"RETAIN",
	"RETURN",
	"SELECT",
	"SEND",
	"SKIP",
	"SNEAK",
	"SPACING",
	"START",
	"SUPERIMPOSE",
	"TABS",
	"TEXTAREA",
	"TITLEAREA",
	"TURNOFF",
	"TURNON",
	"USERERR",
	"VARIABLE",
	"VERBATIM",
	"WIDEN",
	NULL ;
OWN STRING ARRAY CMDNAME[0:68] ;
comment, Only first words of commands are reserved ;

PROCEDURES
PUBLIC SIMPLE PROCEDURE COMMD! ;$"#
BEGIN "COMMD!"
DEPTH ← 0 ;
FOR I ← 0 STEP 1 WHILE FULSTR(CMDNAME[I]) DO
	BIND(DECLARE(SYMNUM(CMDNAME[I]), CMDTYPE), I) ;
DEPTH ← 2 ;
!COMMAND!CHARACTER! ← "." ;
IXCOMMENT ← LDB(IXN(SYMNUM("COMMENT"))) ;
END "COMMD!" ;
PUBLIC RECURSIVE BOOLEAN PROCEDURE COMMAND ;$"#
BEGIN
DEFINE DB(WHAT) = [BEGIN IF ON THEN WHAT; PASS END],
	BDB(WHAT)= [BEGIN IF ON THEN BEGIN DBREAK; WHAT END; PASS END];
IF THATISID AND SYMLOOK(THISWD&THATWD) AND LDB(TYPEN(SYMBOL))=CMDTYPE THEN
	BEGIN THISWD ← SYM[SYMB←SYMBOL] ; THISTYPE ← CMDTYPE ;
	IX ← LDB(IXN(SYMB)) ;  RDENTITY ; END
ELSE IF THISTYPE NEQ CMDTYPE THEN RETURN(FALSE) ;
CASE IX OF
BEGIN COMMENT COMMANDS ;	comment THISWD is command word.;
COMMENT ADJUST	; BDB(JUSTM←1) ;
COMMENT AFTER	; DRESPONSE(2) ;
COMMENT APART	; BEGIN DAPART ; PASS END ;
COMMENT AREA	; DAREA(FALSE) ;
COMMENT AT	; DRESPONSE(1) ;
COMMENT BEFORE	; DRESPONSE(0) ;
COMMENT BEGIN	; BEGIN BEGINBLOCK(FALSE, IF ENDCASE=2 AND ON THEN -1 ELSE 1,
			IF THATISCON THEN SPASS(THATWD[2 TO ∞]) ELSE NULL) ; PASS END ;
COMMENT BLANK PAGE; DBLANKPAGE ;
COMMENT BREAK	; BEGIN DBREAK ; PASS END ;
COMMENT BURP	; DBURP ; TES 8/19/74 BURP OUT STATE INFO ;
COMMENT CENTER	; BDB(BREAKM←4) ;
COMMENT CLOSE	; DCLOSE ;
COMMENT COMMAND CHARACTER ; DCOMMANDCHARACTER ;
COMMENT COMMENT	; BEGIN IMPOSSIBLE("COMMAND") ; PASS END ;
COMMENT COMPACT	; DB(SPACEM←IF FILL THEN 1 ELSE 2) ;
COMMENT CONTINUE; BDB(NOPGPH ← 1) ;
COMMENT COUNT	; DCOUNT ;
COMMENT CRBREAK	; DB(CRBM←1) ;
COMMENT CRSPACE	; DB(CRBM←0) ;
COMMENT DDT	; BEGIN REPORT(0, "DDT", "D") ; PASS END ;
COMMENT DEVICE	; DDEVICE ;
COMMENT DONE	; DDONE(FALSE) ; TES 8/14/74 AND 8/19/74  ;
COMMENT END	; CASE IF STARTS THEN 0 ELSE ENDCASE OF BEGIN ENDSTART; ENDBEGIN; ENDONCE; ENDRESP END ;
COMMENT FILL	; BDB(BREAKM ← 0 ; SPACEM ← SPACEM MIN 1) ;
COMMENT FLUSH LEFT; BDB(BREAKM←2) ;
COMMENT FLUSH RIGHT; BDB(BREAKM←3) ;
COMMENT FONT	; DFONT(FALSE);
COMMENT GROUP	; IF GROUPM THEN PASS ELSE BDB(GROUPM←1) ;
COMMENT GROUP SKIP; DSKIP(TRUE) ;
COMMENT IF	; DCONDITIONAL ;
COMMENT INDENT	; DINDENT ;
COMMENT INSERT	; DINSERT ;
COMMENT JUSTJUST; BDB(BREAKM←1) ;
COMMENT MACRO	; DMACRO(1) ;
COMMENT NARROW	; DMARGINS(1) ; COMMENT SEMI-OBSOLETE ;
COMMENT NEXT	; BEGIN PASS ; DNEXT END ;
COMMENT NOFILL	; BDB(BREAKM←7) ;
COMMENT NOJUST	; BDB(JUSTM←0) ;
COMMENT ONCE	; BEGIN IF ON AND ENDCASE NEQ 2 THEN BEGIN INTEGER S ; S ← STARTS ; STARTS ← 0 ;
			BEGINBLOCK(FALSE,2,ALTMODE) ; STARTS ← S ; END ; PASS END ;
COMMENT PAGE FRAME; DFRAME(FALSE) ;
COMMENT PICHAR	; DPICHAR ;
COMMENT PLACE	; BEGIN IF ON THEN DBREAK ; PASS ; PLACE(IX) ; PASS END ;
COMMENT PORTION	; DPORTION ;
COMMENT PREFACE	; DPREFACE ; TES 11/2/74 ;
COMMENT PROCEDURE; DMACRO(2) ; TES 8/19/74 ;
COMMENT PUB!DEBUG; DPUB!DEBUG ; TES 8/21/74 ;
COMMENT RECEIVE	; DRECEIVE ;
COMMENT RECURSIVE MACRO ; DMACRO(0) ;
COMMENT REPEAT	; DREPEAT ;
COMMENT REQUIRE	; DREQUIRE ;
COMMENT RETAIN	; DB(SPACEM←0) ;
COMMENT RETURN	; DDONE(TRUE) ; TES 8/19/74 ;
COMMENT SELECT	; DFONT(TRUE) ;
COMMENT SEND	; DSEND ;
COMMENT SKIP	; DSKIP(FALSE) ;
COMMENT SNEAK	; COMMENT (COMMENTED OUT BH 11/5/74, WOULDN'T COMPILE DSNEAK ;;
COMMENT SPACING	; DSPACING ; TES 11/2/74 ;
COMMENT START	; BEGIN BEGINBLOCK(FALSE,0,IF THATISCON THEN SPASS(THATWD[2 TO ∞]) ELSE NULL) ; PASS END;
COMMENT SUPERIMPOSE; DSUPERIMPOSE ;
COMMENT TABS	; DTABS ;
COMMENT TEXT AREA; DAREA(FALSE) ;
COMMENT TITLE AREA; DAREA(TRUE) ;
COMMENT TURN OFF; DTURN(0) ;
COMMENT TURN ON	; DTURN(-1) ;
COMMENT USERERR	; DUSERERR ;   RKJ: 1-9-74;
COMMENT VARIABLE; DVARIABLE ;
COMMENT VERBATIM; BDB(BREAKM←6) ;
COMMENT WIDEN	; DMARGINS(-1) ; COMMENT SEMI-OBSOLETE ;
END ; COMMENT COMMANDS ;
IF ITSCH(;) THEN PASS ;
RETURN(TRUE) ;
END ;
PRIVATE SIMPLE PROCEDURE DCOMMANDCHARACTER ;$"#
BEGIN
INTEGER X ;
INPUTSTR ← ";;" & INPUTSTR ; COMMENT couple extra semicolons to assure next line read right ;
PASS ; X ← SIMPAR ;
IF LENGTH(X) NEQ 1 THEN WARN("=",<"COMMAND CHARACTER must be a single character, not '"&X&"'">)
ELSE IF ON THEN !COMMAND!CHARACTER! ← X ;
PASS ; PASS ; PASS ;
END "DCOMMANDCHARACTER" ;
PUBLIC RECURSIVE PROCEDURE PARAMS(INTEGER MOST; STRING ARRAY PRE,PAR,POST) ;$"#
BEGIN comment, Reads arguments for various commands;
INTEGER I, PREWD, SOFAR ;  STRING EXPR ;
LABEL RDPAR, SETPAR ;
BOOLEAN GOT ; DEFINE FIND = [FOR I ← 1 THRU MOST DO IF];
SOFAR ← I ← GOT ← 0 ;
WHILE SOFAR<MOST AND THISTYPE NEQ -TERQ AND THISTYPE NEQ CMDTYPE DO
BEGIN "PARAMETER"
IF THISISID THEN
	BEGIN "IDENTIFIER"
	IF ITS(TO) AND I<MOST AND ITSV(PRE[I+1]) THEN BEGIN PASS; I←I+1; GO TO RDPAR END;
	FIND ITSV(PRE[I]) OR ITSV(PRE[I]&"S") THEN
		BEGIN "PRE WORD"
		PASS ; IF GOT LAND TWO(I) THEN WARN("=",PRE[I]&" Twice") ;
		GO TO RDPAR ;
		END "PRE WORD" ;
	END "IDENTIFIER" ;
FIND  NOT GOT LAND TWO(I)  AND  NULSTR(PRE[I])  AND  (I=1 OR NULSTR(PRE[I-1]) OR GOT LAND TWO((I-1)))  THEN GO TO RDPAR ;
DONE ;
RDPAR:
PREWD ← I ;
EXPR ←  IF EQU(PRE[I],"IN") AND FULSTR(PAR[I]) THEN SPASS(THISWD) comment COUNT...IN -- ;
	ELSE IF ITSCH(⊂) THEN 0 & DEFN(FALSE, FALSE, 0, 0)
	ELSE E(NULL,IF I=MOST OR FULSTR(POST[I]) THEN POST[I] ELSE PRE[I+1]) ;
IF FULSTR(POST[I]) THEN
	IF ITSV(POST[I]) THEN PASS
	ELSE	BEGIN "GUESSED WRONG"
		FIND ITSV(POST[I]) THEN BEGIN PASS ; GO TO SETPAR END ;
		FIND NULSTR(POST[I]) THEN GO TO SETPAR ;
		WARN("=",POST[PREWD] & "Missed.") ;
		DONE ;
		END "GUESSED WRONG" ;
SETPAR:
IF PRE[I] NEQ PRE[PREWD] THEN WARN("=",<(IF FULSTR(POST[PREWD]) THEN POST[PREWD] ELSE PRE[I])& " Missed.">) ;
IF GOT LAND TWO(I) THEN WARN("=","Duplicate Parameter "&PRE[I]&SP&EXPR&SP&POST[I])
ELSE SOFAR ← SOFAR + 1 ;
GOT ← GOT LOR TWO(I) ;
PAR[I] ← EXPR ;
IF ITSCH(<,>) THEN PASS ;
END "PARAMETER" ;
END "PARAMS" ;
PUBLIC RECURSIVE STRING PROCEDURE SIMPAR ;$"#
	RETURN(IF THISISCON THEN THISWD[2 TO ∞] ELSE IF THISISID THEN VEVAL ELSE NULL) ;
FINISHED

ENDOF("COMMD")